home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / POPS.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-07-11  |  9.8 KB  |  298 lines  |  [.Ob./.Ob4]
  1. Syntax10b.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. Courier10.Scn.Fnt
  5. MODULE POPS;    (* NW, RC 6.3.89 / 18.10.92 *)
  6.     IMPORT
  7.         OPM := POPM;
  8.     CONST
  9.         MaxStrLen* = 256;
  10.         MaxIdLen = 24;
  11.     TYPE
  12.         Name* = ARRAY MaxIdLen OF CHAR;
  13.         String* = ARRAY MaxStrLen OF CHAR;
  14.     (* name, str, numtyp, intval, realval, lrlval are implicit results of Get *)
  15.         name*: Name;
  16.         str*: String;
  17.         numtyp*: INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal *)
  18.         intval*: LONGINT;    (* integer value or string length *)
  19.         realval*: REAL;
  20.         lrlval*: LONGREAL;
  21.     (*symbols:
  22.         |  0          1          2          3          4
  23.      ---|--------------------------------------------------------
  24.       0 |  null       *          /          DIV        MOD
  25.       5 |  &          +          -          OR         =
  26.      10 |  #          <          <=         >          >=
  27.      15 |  IN         IS         ^          .          ,
  28.      20 |  :          ..         )          ]          }
  29.      25 |  OF         THEN       DO         TO         BY
  30.      30 |  (          [          {          ~          :=
  31.      35 |  number     NIL        string     ident      ;
  32.      40 |  |          END        ELSE       ELSIF      UNTIL
  33.      45 |  IF         CASE       WHILE      REPEAT     FOR
  34.      50 |  LOOP       WITH       EXIT       RETURN     ARRAY
  35.      55 |  RECORD     POINTER    BEGIN      CONST      TYPE
  36.      60 |  VAR        PROCEDURE  IMPORT     MODULE     eof    *)
  37.     CONST
  38.         (* numtyp values *)
  39.         char = 1; integer = 2; real = 3; longreal = 4;
  40.         (*symbol values*)
  41.         null = 0; times = 1; slash = 2; div = 3; mod = 4;
  42.         and = 5; plus = 6; minus = 7; or = 8; eql = 9;
  43.         neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  44.         in = 15; is = 16; arrow = 17; period = 18; comma = 19;
  45.         colon = 20; upto = 21; rparen = 22; rbrak = 23; rbrace = 24;
  46.         of = 25; then = 26; do = 27; to = 28; by = 29;
  47.         lparen = 30; lbrak = 31; lbrace = 32; not = 33; becomes = 34;
  48.         number = 35; nil = 36; string = 37; ident = 38; semicolon = 39;
  49.         bar = 40; end = 41; else = 42; elsif = 43; until = 44;
  50.         if = 45; case = 46; while = 47; repeat = 48; for = 49;
  51.         loop = 50; with = 51; exit = 52; return = 53; array = 54;
  52.         record = 55; pointer = 56; begin = 57; const = 58; type = 59;
  53.         var = 60; procedure = 61; import = 62; module = 63; eof = 64;
  54.         ch: CHAR;     (*current character*)
  55.     PROCEDURE err(n: INTEGER);
  56.     BEGIN OPM.err(n)
  57.     END err;
  58.     PROCEDURE Str(VAR sym: SHORTINT);
  59.         VAR i: INTEGER; och: CHAR;
  60.     BEGIN i := 0; och := ch;
  61.         LOOP OPM.Get(ch);
  62.             IF ch = och THEN EXIT END ;
  63.             IF ch < " " THEN err(3); EXIT END ;
  64.             IF i = MaxStrLen-1 THEN err(241); EXIT END ;
  65.             str[i] := ch; INC(i)
  66.         END ;
  67.         OPM.Get(ch); str[i] := 0X; intval := i + 1;
  68.         IF intval = 2 THEN
  69.             sym := number; numtyp := 1; intval := ORD(str[0])
  70.         ELSE sym := string
  71.         END
  72.     END Str;
  73.     PROCEDURE Identifier(VAR sym: SHORTINT);
  74.         VAR i: INTEGER;
  75.     BEGIN i := 0;
  76.         REPEAT
  77.             name[i] := ch; INC(i); OPM.Get(ch)
  78.         UNTIL (ch < "0") OR ("9" < ch) & (CAP(ch) < "A") OR ("Z" < CAP(ch)) OR (i = MaxIdLen);
  79.         IF i = MaxIdLen THEN err(240); DEC(i) END ;
  80.         name[i] := 0X; sym := ident
  81.     END Identifier;
  82.     PROCEDURE Number;
  83.         VAR i, m, n, d, e: INTEGER; dig: ARRAY 24 OF CHAR; f: LONGREAL; expCh: CHAR; neg: BOOLEAN;
  84.         PROCEDURE Ten(e: INTEGER): LONGREAL;
  85.             VAR x, p: LONGREAL;
  86.         BEGIN x := 1; p := 10;
  87.             WHILE e > 0 DO
  88.                 IF ODD(e) THEN x := x*p END;
  89.                 e := e DIV 2;
  90.                 IF e > 0 THEN p := p*p END (* prevent overflow *)
  91.             END;
  92.             RETURN x
  93.         END Ten;
  94.         PROCEDURE Ord(ch: CHAR; hex: BOOLEAN): INTEGER;
  95.         BEGIN (* ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") *)
  96.             IF ch <= "9" THEN RETURN ORD(ch) - ORD("0")
  97.             ELSIF hex THEN RETURN ORD(ch) - ORD("A") + 10
  98.             ELSE err(2); RETURN 0
  99.             END
  100.         END Ord;
  101.     BEGIN (* ("0" <= ch) & (ch <= "9") *)
  102.         i := 0; m := 0; n := 0; d := 0;
  103.         LOOP (* read mantissa *)
  104.             IF ("0" <= ch) & (ch <= "9") OR (d = 0) & ("A" <= ch) & (ch <= "F") THEN
  105.                 IF (m > 0) OR (ch # "0") THEN (* ignore leading zeros *)
  106.                     IF n < LEN(dig) THEN dig[n] := ch; INC(n) END;
  107.                     INC(m)
  108.                 END;
  109.                 OPM.Get(ch); INC(i)
  110.             ELSIF ch = "." THEN OPM.Get(ch);
  111.                 IF ch = "." THEN (* ellipsis *) ch := 7FX; EXIT
  112.                 ELSIF d = 0 THEN (* i > 0 *) d := i
  113.                 ELSE err(2)
  114.                 END
  115.             ELSE EXIT
  116.             END
  117.         END; (* 0 <= n <= m <= i, 0 <= d <= i *)
  118.         IF d = 0 THEN (* integer *)
  119.             IF n = m THEN intval := 0; i := 0;
  120.                 IF ch = "X" THEN (* character *) OPM.Get(ch); numtyp := char;
  121.                     IF n <= 2 THEN
  122.                         WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
  123.                     ELSE err(203)
  124.                     END
  125.                 ELSIF ch = "H" THEN (* hexadecimal *) OPM.Get(ch); numtyp := integer;
  126.                     IF n <= OPM.MaxHDig THEN
  127.                         IF (n = OPM.MaxHDig) & (dig[0] > "7") THEN (* prevent overflow *) intval := -1 END;
  128.                         WHILE i < n DO intval := intval*10H + Ord(dig[i], TRUE); INC(i) END
  129.                     ELSE err(203)
  130.                     END
  131.                 ELSE (* decimal *) numtyp := integer;
  132.                     WHILE i < n DO d := Ord(dig[i], FALSE); INC(i);
  133.                         IF intval <= (MAX(LONGINT) - d) DIV 10 THEN intval := intval*10 + d
  134.                         ELSE err(203)
  135.                         END
  136.                     END
  137.                 END
  138.             ELSE err(203)
  139.             END
  140.         ELSE (* fraction *)
  141.             f := 0; e := 0; expCh := "E";
  142.             WHILE n > 0 DO (* 0 <= f < 1 *) DEC(n); f := (Ord(dig[n], FALSE) + f)/10 END;
  143.             IF (ch = "E") OR (ch = "D") THEN expCh := ch; OPM.Get(ch); neg := FALSE;
  144.                 IF ch = "-" THEN neg := TRUE; OPM.Get(ch)
  145.                 ELSIF ch = "+" THEN OPM.Get(ch)
  146.                 END;
  147.                 IF ("0" <= ch) & (ch <= "9") THEN
  148.                     REPEAT n := Ord(ch, FALSE); OPM.Get(ch);
  149.                         IF e <= (MAX(INTEGER) - n) DIV 10 THEN e := e*10 + n
  150.                         ELSE err(203)
  151.                         END
  152.                     UNTIL (ch < "0") OR ("9" < ch);
  153.                     IF neg THEN e := -e END
  154.                 ELSE err(2)
  155.                 END
  156.             END;
  157.             DEC(e, i-d-m); (* decimal point shift *)
  158.             IF expCh = "E" THEN numtyp := real;
  159.                 IF (1-OPM.MaxRExp < e) & (e <= OPM.MaxRExp) THEN
  160.                     IF e < 0 THEN realval := SHORT(f / Ten(-e))
  161.                     ELSE realval := SHORT(f * Ten(e))
  162.                     END
  163.                 ELSE err(203)
  164.                 END
  165.             ELSE numtyp := longreal;
  166.                 IF (1-OPM.MaxLExp < e) & (e <= OPM.MaxLExp) THEN
  167.                     IF e < 0 THEN lrlval := f / Ten(-e)
  168.                     ELSE lrlval := f * Ten(e)
  169.                     END
  170.                 ELSE err(203)
  171.                 END
  172.             END
  173.         END
  174.     END Number;
  175.     PROCEDURE Get*(VAR sym: SHORTINT);
  176.         VAR s: SHORTINT;
  177.         PROCEDURE Comment;    (* do not read after end of file *)
  178.         BEGIN OPM.Get(ch);
  179.             LOOP
  180.                 LOOP
  181.                     WHILE ch = "(" DO OPM.Get(ch);
  182.                         IF ch = "*" THEN Comment END
  183.                     END ;
  184.                     IF ch = "*" THEN OPM.Get(ch); EXIT END ;
  185.                     IF ch = OPM.Eot THEN EXIT END ;
  186.                     OPM.Get(ch)
  187.                 END ;
  188.                 IF ch = ")" THEN OPM.Get(ch); EXIT END ;
  189.                 IF ch = OPM.Eot THEN err(5); EXIT END
  190.             END
  191.         END Comment;
  192.     BEGIN
  193.         OPM.errpos := OPM.curpos-1;
  194.         WHILE ch <= " " DO (*ignore control characters*)
  195.             IF ch = OPM.Eot THEN sym := eof; RETURN
  196.             ELSE OPM.Get(ch)
  197.             END
  198.         END ;
  199.         CASE ch OF   (* ch > " " *)
  200.             | 22X, 27X  : Str(s)
  201.             | "#"  : s := neq; OPM.Get(ch)
  202.             | "&"  : s :=  and; OPM.Get(ch)
  203.             | "("  : OPM.Get(ch);
  204.                              IF ch = "*" THEN Comment; Get(s)
  205.                                  ELSE s := lparen
  206.                              END
  207.             | ")"  : s := rparen; OPM.Get(ch)
  208.             | "*"  : s :=  times; OPM.Get(ch)
  209.             | "+"  : s :=  plus; OPM.Get(ch)
  210.             | ","  : s := comma; OPM.Get(ch)
  211.             | "-"  : s :=  minus; OPM.Get(ch)
  212.             | "."  : OPM.Get(ch);
  213.                              IF ch = "." THEN OPM.Get(ch); s := upto ELSE s := period END
  214.             | "/"  : s := slash;  OPM.Get(ch)
  215.             | "0".."9": Number; s := number
  216.             | ":"  : OPM.Get(ch);
  217.                              IF ch = "=" THEN OPM.Get(ch); s := becomes ELSE s := colon END
  218.             | ";"  : s := semicolon; OPM.Get(ch)
  219.             | "<"  : OPM.Get(ch);
  220.                              IF ch = "=" THEN OPM.Get(ch); s := leq ELSE s := lss END
  221.             | "="  : s :=  eql; OPM.Get(ch)
  222.             | ">"  : OPM.Get(ch);
  223.                              IF ch = "=" THEN OPM.Get(ch); s := geq ELSE s := gtr END
  224.             | "A": Identifier(s); IF name = "ARRAY" THEN s := array END
  225.             | "B": Identifier(s);
  226.                         IF name = "BEGIN" THEN s := begin
  227.                         ELSIF name = "BY" THEN s := by
  228.                         END
  229.             | "C": Identifier(s);
  230.                         IF name = "CASE" THEN s := case
  231.                         ELSIF name = "CONST" THEN s := const
  232.                         END
  233.             | "D": Identifier(s);
  234.                         IF name = "DO" THEN s := do
  235.                         ELSIF name = "DIV" THEN s := div
  236.                         END
  237.             | "E": Identifier(s);
  238.                         IF name = "END" THEN s := end
  239.                         ELSIF name = "ELSE" THEN s := else
  240.                         ELSIF name = "ELSIF" THEN s := elsif
  241.                         ELSIF name = "EXIT" THEN s := exit
  242.                         END
  243.             | "F": Identifier(s); IF name = "FOR" THEN s := for END
  244.             | "I": Identifier(s);
  245.                         IF name = "IF" THEN s := if
  246.                         ELSIF name = "IN" THEN s := in
  247.                         ELSIF name = "IS" THEN s := is
  248.                         ELSIF name = "IMPORT" THEN s := import
  249.                         END
  250.             | "L": Identifier(s); IF name = "LOOP" THEN s := loop END
  251.             | "M": Identifier(s);
  252.                         IF name = "MOD" THEN s := mod
  253.                         ELSIF name = "MODULE" THEN s := module
  254.                         END
  255.             | "N": Identifier(s); IF name = "NIL" THEN s := nil END
  256.             | "O": Identifier(s);
  257.                         IF name = "OR" THEN s := or
  258.                         ELSIF name = "OF" THEN s := of
  259.                         END
  260.             | "P": Identifier(s);
  261.                         IF name = "PROCEDURE" THEN s := procedure
  262.                         ELSIF name = "POINTER" THEN s := pointer
  263.                         END
  264.             | "R": Identifier(s);
  265.                         IF name = "RECORD" THEN s := record
  266.                         ELSIF name = "REPEAT" THEN s := repeat
  267.                         ELSIF name = "RETURN" THEN s := return
  268.                         END
  269.             | "T": Identifier(s);
  270.                         IF name = "THEN" THEN s := then
  271.                         ELSIF name = "TO" THEN s := to
  272.                         ELSIF name = "TYPE" THEN s := type
  273.                         END
  274.             | "U": Identifier(s); IF name = "UNTIL" THEN s := until END
  275.             | "V": Identifier(s); IF name = "VAR" THEN s := var END
  276.             | "W": Identifier(s);
  277.                         IF name = "WHILE" THEN s := while
  278.                         ELSIF name = "WITH" THEN s := with
  279.                         END
  280.             | "G".."H", "J", "K", "Q", "S", "X".."Z": Identifier(s)
  281.             | "["  : s := lbrak; OPM.Get(ch)
  282.             | "]"  : s := rbrak; OPM.Get(ch)
  283.             | "^"  : s := arrow; OPM.Get(ch)
  284.             | "a".."z": Identifier(s)
  285.             | "{"  : s := lbrace; OPM.Get(ch)
  286.             | "|"  : s := bar; OPM.Get(ch)
  287.             | "}"  : s := rbrace; OPM.Get(ch)
  288.             | "~"  : s := not; OPM.Get(ch)
  289.             | 7FX  : s := upto; OPM.Get(ch)
  290.         ELSE s :=  null; OPM.Get(ch)
  291.         END ;
  292.         sym := s
  293.     END Get;
  294.     PROCEDURE Init*;
  295.     BEGIN ch := " "
  296.     END Init;
  297. END POPS.
  298.